#!/usr/bin/perl -wc

# Mail host resolution in accordance with RFC 2821, section 5.

package RFCMail::DNS::MXData;

use strict;
use RFCMail::DNS::DNSUtils qw(dns_lookup);


sub new {
    my ($class, $domain) = @_;
    my $self = bless {cname => [$domain]}, $class;
    $self->{status} = eval {
	my @mxs;
	my $mx_type = 'IMPLICIT';
	for (dns_lookup($domain, "MX")) {
	    my $type = $_->type;
	    if ($type eq 'CNAME') {
		push @{$self->{cname}}, $_->cname;
	    }
	    elsif ($type eq 'MX') {
		$mx_type = 'EXPLICIT';
		push @mxs, RFCMail::DNS::MXData::MX->new($_->exchange, $_->preference)
		    if $_->exchange;
	    }
	}
	return ("NO/NOMAIL") # only a "dot" MX: an explicitly non-mail domain
	    if $mx_type eq 'EXPLICIT' and not @mxs;
	# try for A if no MXs
	push @mxs, RFCMail::DNS::MXData::MX->new($self->cname)
	    if not @mxs;
	return ("NO/INVALID") # all possible MXs produce no valid address
	    if not map { $_->addrs } @mxs;
	our ($a, $b);
	$self->{mxs} = [sort { $a->pref <=> $b->pref } @mxs];
	return ("OK/$mx_type");
    };
    if ($@) { ($self->{status}) = $@ =~ /(.*)/ }
    return ($self);
}


sub status { $_[0]->{status} }


sub mxs { defined($_[0]->{mxs}) ? @{$_[0]->{mxs}} : () }


sub cname { $_[0]->{cname}->[-1] }


sub includes_host {
    my ($self, $host) = @_;
    for my $mx ($self->mxs) {
	for ($mx->addrs) {
	    return ($mx->name)
		if $_ eq $host;
	}
    }
    return ();
}



package RFCMail::DNS::MXData::MX;

use strict;
use RFCMail::DNS::DNSUtils qw(filtered_dns_lookup);


sub new {
    my ($class, $name, $pref) = @_;
    $pref = 0
	unless defined($pref);
    my $self = bless {preference => $pref + rand(1), exchange => $name}, $class;
    $self->{addrs} = [eval { map($_->address, filtered_dns_lookup($name, "A")) }];
    return ($self);
}


sub name { $_[0]->{exchange} }


sub pref { $_[0]->{preference} }


sub addrs { @{$_[0]->{addrs}} }



1;
